## Registered S3 method overwritten by 'httr':
## method from
## print.response rmutil
## Warning: package 'tseries' was built under R version 4.3.2
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Warning: package 'cowplot' was built under R version 4.3.2
Crear una muestra aleatoria de tamaño 120
#primero leemos el excel y lo guardamos en un data frame en este caso :
Blackfriday=data.frame(read_xlsx("C:/Users/alejo/Desktop/Blackfriday.xlsx"))
#Despues establecemos el tamaño de la muestra y con ese tamaño usamos la funcion sample :
n=120
muestra=sample(1:nrow(Blackfriday),size=n,replace=FALSE)
#Finalmente relacionamos nuestra muestra con los datos obtenidos del excel:
datosfinales = Blackfriday[muestra, ]
datosfinalesvalores= datosproblema$Freq
nombres_porcentajes=c("Mujer","Hombre")
porcentajes <- (valores / sum(valores)) * 100
colores <- c("#3498db", "#e74c3c")
plot_ly(labels = nombres_porcentajes, values = porcentajes, type = "pie",
textinfo = "label+percent", text = datosproblema$Var1 , marker = list(colors = colores)) %>%
layout(title = list(font="Porcentajes Entre Hombre y Mujer"),
showlegend = FALSE, # Ocultar la leyenda
margin = list(l = 20, r = 0, b = 0, t = 30), # Ajustar márgenes
paper_bgcolor = "white", # Fondo blanco
plot_bgcolor = "white", # Fondo blanco
font = list(family = "Arial", size = 14), # Fuente y tamaño de texto
titlefont = list(size = 18), # Tamaño del título
annotations = list(text = "Fuente: Datos de ejemplo", showarrow = FALSE,
x = 0.8, y = -0.15)) # Nota de fuente## Warning: The titlefont attribute is deprecated. Use title = list(font = ...)
## instead.
Al ser una variable cualitativa no podemos obtener sus medidas de tendencia central, sin embargo como se vera mas a delante la usaremos para generar grupos de datos y asi hacer su respectivo analisis
valores= datosproblema$Freq
nombres_porcentajes=c("CITY A","CITY B","CITY C")
porcentajes <- (valores / sum(valores)) * 100
colores <- c("#BFCDFF", "#E4FFBF","#B8FFD9")
plot_ly(labels = nombres_porcentajes, values = datosproblema$Freq, type = "pie",
textinfo = "label+percent", text = datosproblema$Var1 , marker = list(colors = colores)) %>%
layout(title = list(font="Porcentajes de ciudades en la muestra"),
showlegend = FALSE, # Ocultar la leyenda
margin = list(l = 20, r = 0, b = 0, t = 30), # Ajustar márgenes
paper_bgcolor = "white", # Fondo blanco
plot_bgcolor = "white", # Fondo blanco
font = list(family = "Arial", size = 14), # Fuente y tamaño de texto
titlefont = list(size = 18), # Tamaño del título
annotations = list(text = "Fuente: Datos de ejemplo", showarrow = FALSE,
x = 0.8, y = -0.15)) # Nota de fuente## Warning: The titlefont attribute is deprecated. Use title = list(font = ...)
## instead.
datosproblema=datosfinales$Income
Media_Datos=median(datosproblema)
Moda=mfv(datosproblema)
Promedio=mean(datosproblema)
#hist(datosproblema)
g1 = ggplot(data = data.frame(datosproblema),mapping = aes(x = datosproblema)) +
geom_histogram(bins = 20,colour="white",fill="#FFEA89")+
labs(title = "Histograma income", y ="Cantidad") +
geom_vline(aes(xintercept= Promedio ,color ="MEDIA"),linetype = "dashed",linewidth = 0.5) +
geom_vline(aes(xintercept= Media_Datos,color = "MEDIANA"),linetype = "dashed",linewidth = 1) +
scale_color_manual(name = "Informacion",values = c(MEDIANA ="blue" ,MEDIA = "red",MODA ="purple"))
g1primero cacularemos la media y desviacion estandar de la poblacion general
## La media de la poblacion es: 9508.259
## La desviacion estandar de la poblacion es: 5001.657
Ahora calcularemos la media y desviacion estandar de la muestra
## La media de la muestra es: 9993.358
## La desviacion estandar de la muestra es: 5360.271
En situiaciones como estas el estimador es la MUESTRA, esto debido a que normalmente se desconocen todos los datos de l apoblacion, por lo cual se toma una muestra lo suficientemente grande para obtener los datos mas cercanos posibles desconociendo la totalidad de los datos de la poblacion
Ahora miraremos la probabilidad de que la variable media muestral sea mayor o igual que el valor de la poblacional.
z <- round(( mean(Blackfriday$Purchase) - mean(datosfinales$Purchase))/sd(datosfinales$Purchase),2)
probabilidad <- round(pnorm(q=z,mean = 0, sd=1,lower.tail = FALSE),1)
cat("la probabilidad de que la variable media muestral sea mayor o igual que el valor de la
poblacional es de :",(probabilidad*100),"%")## la probabilidad de que la variable media muestral sea mayor o igual que el valor de la
## poblacional es de : 50 %
Al no haber una inclinacion muy marcada o significativa en que la media muestral sea igual o mayor que la media poblacional se considera que los segos son muy bajos por no decir inexistentes
datosproblema=datosfinales$Purchase
Mediana_Datos=round(median(datosproblema),0)
Moda=mfv(datosproblema)
Promedio=round(mean(datosproblema),0)
sdi=round(sd(datosproblema),0)
#hist(datosproblema)
g1 = ggplot(data = data.frame(datosproblema),mapping = aes(x = datosproblema)) +
geom_histogram(bins = 20,colour="white",fill="#FFBCFD")+
labs(title = "Histograma variable PurchaseS", y ="Cantidad") +
#geom_vline(aes(xintercept= Promedio ,color ="MEDIA"),linetype = "dashed",linewidth = 1) +
#(aes(xintercept= Media_Datos,color = "MEDIANA"),linetype = "dashed",linewidth = 1) +
#scale_color_manual(name = "Informacion",values = c(MEDIANA ="#5DFF00" ,MEDIA = "#6E00FF")) +
stat_function(fun = dnorm, n = 10000, args = list(mean = Promedio, sd = sdi)) + ylab("") +
scale_y_continuous(breaks = NULL)
g1
Ahora caalcularemos la courtosis :
## [1] 3.057671
Ahoraa calcularemos la asimetria con la funcion skewness
## [1] 0.08577722